(library (grid-gen maxima)

(export maxima:simplify)

(import (guile)
        (rnrs)
        (except (srfi srfi-1) map)
)
(import (grid-gen main))
(import (grid-gen vars))
(import (grid-gen code))
(import (grid-gen math))
(import (grid-gen symath))

(define vrcnt 0)

(define ggf->maxima (lambda (v vhs)
  (let ((f (car v))
        (ars (map (lambda (x) (gg->maxima x vhs)) (cdr v)))
       )
    (cond ((eq? f '+) (format #f "(~a)" (string-join ars "+")))
          ((eq? f '-) (format #f "(~a)" (string-join ars "-")))
          ((eq? f '*) (format #f "(~a)" (string-join ars "*")))
          ((eq? f '/) (format #f "(~a)" (string-join ars "/")))
          ((eq? f '**) (format #f "((~a)^(~a))" (car ars) (cadr ars)))
          (#t (format #f "~a(~a)" (symbol->string f) (string-join ars ",")))
    )
  )
))

(define gg->maxima (lambda (v vhs)
  (cond ((number? v) (format #f "(~a)" v))
        ((or (is-var? v) (is-ptr? v) (symbol? v) (procedure? v))
         (let ((vs (hash-ref vhs v #f)))
           (if vs
               vs
               (let ((vn (string-append "vr" (number->string vrcnt))))
                 (set! vrcnt (+ vrcnt 1))
                 (hash-set! vhs v vn)
                 vn
               )
           )
         )
        )
        ((and (list? v) (> (length v) 1))
         (ggf->maxima v vhs)
        )
        (#t (int-err "Cannot convert exp to maxima format!"))
  )
))

(define maxima->ggf (lambda (v rhs)
  (let ((f (caar v))
        (ars (map (lambda (x) (maxima->gg x rhs)) (cdr v)))
       )
    (cond ((equal? f 'MPLUS) (cons '+ ars))
          ((equal? f 'MTIMES) (cons '* ars))
          ((equal? f 'MEXPT) 
           (cond ((and (number? (cadr ars)) (= (cadr ars) -1))
                 `(/ 1.0 ,(car ars))
                 )
                 ((and (number? (cadr ars)) (= (cadr ars) 0.5))
                 `(sqrt ,(car ars))
                 )
                 ((and (number? (cadr ars)) (= (cadr ars) -0.5))
                 `(/ 1.0 (sqrt ,(car ars)))
                 )
                 ((and (number? (car ars)) (= (car ars) 2.71828182845905))
                 `(exp ,(cadr ars))
                 )
                 (#t (cons '** ars))
           )
          )
          ((eq? f 'RAT)  (cons '/ ars))
          ((eq? f '%SIN) (cons 'sin ars))
          ((eq? f '%COS) (cons 'cos ars))
          ((eq? f '%TAN) (cons 'tan ars))
          ((eq? f '%ASIN) (cons 'asin ars))
          ((eq? f '%ACOS) (cons 'acos ars))
          ((eq? f '%ATAN) (cons 'atan ars))
          ((eq? f '%LOG) (cons 'log ars))
          ((eq? f '$SIGN) (cons 'sign ars))
          ((eq? f '$MIN) (cons 'min ars))
          ((eq? f '$MAX) (cons 'max ars))
          ((eq? f 'MABS) (cons 'abs ars))
          (#t (format #t "F: ~a\n" f)
              (int-err "Cannot convert function to maxima format")
          )
    )
  )
))

(define maxima->gg (lambda (v rhs)
  (cond ((number? v) (+ v 0.0))
        ((symbol? v)
         (cond ((eq? v '$%E) 2.71828182845905)
               ((eq? v '$%PI) 3.1415926)
               (#t (let ((vs (hash-ref rhs v #f)))
                     (if vs
                         vs
                         (int-err "Cannot interpret symbol from maxima output!")
                     )
                   )
                )
         )
        )
        ((and (list? v) (> (length v) 1))
         (maxima->ggf v rhs)
        )
        (#t (int-err "Cannot convert from maxima format!"))
  )
))

(define reverse-vhs (lambda (vhs rhs)
  (hash-for-each
    (lambda (k v)
      (hash-set! rhs
                 (string->symbol (string-append "|$" v "|"))
                 k
      )
      (hash-set! rhs
                 (string->symbol (string-append "$" (string-upcase v)))
                 k
      )
    )
    vhs
  )
))

(def-cache maxima:simplify1 (lambda (ex)
  (let* ((ifl (string-copy "./maxima-in-XXXXXXXX"))
         (ofl (string-copy "./maxima-out-XXXXXXXX"))
         (ifs  (mkstemp! ifl))
         (ofs  (mkstemp! ofl))
         (cmd (format #f (string-append
                  "f:trigsimp(~a),keepfloat;\n"
                  ":lisp (with-open-file "
                  "(ss \"~a\" :direction :OUTPUT "
                  ":if-exists "
                  ":SUPERSEDE :if-does-not-exist :CREATE "
                  ") (format ss \"~~S\" $F"
                  "))\n"
                         )
                      ex
                      ofl
              )
         )
        )
    (close ofs)
    (delete-file ofl)
    (format ifs "~a\n" cmd);
    (close ifs)
    (system (format #f "maxima -q -b ./~a >/dev/null 2>&1\n" ifl))
    (let* ((ip (open-input-file ofl))
           (mres (read ip))
          )
      (close ip)
      (delete-file ofl)
      (delete-file ifl)
      mres
    )
  )
))

(define maxima:simplify (lambda (v)
  (set! vrcnt 0)
  (let* ((vhs (make-hash-table))
         (rhs (make-hash-table))
         (ex (gg->maxima (simp-ex (norm-form v)) vhs))
         (mres (maxima:simplify1 ex))
        )
    (reverse-vhs vhs rhs)
    (simp-ex (norm-form (simp-ex (maxima->gg mres rhs))))
  )
))

)

(import (grid-gen main))

(set! MATH:simplify maxima:simplify)
